Lab 11
#install.packages("plotly")
library(plotly)
## Loading required package: ggplot2
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(ggplot2)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(stringr)
library(tidyr)
colleges <- read.csv("https://remiller1450.github.io/data/Colleges2019.csv")
Question 1
plot_ly(colleges) %>%
add_trace(x = ~Private, y = ~Enrollment, type = "violin")
Question 2
plot_ly(data = colleges, hoverinfo = "text") %>%
add_trace(type = "scatter", mode = "markers", x = ~FourYearComp_Males, y = ~FourYearComp_Females, color = ~Private, text = ~str_c("<b>", Name, "<b>", "<br>", "Percentage Female: ", 100 *round(PercentFemale, digits = 2)))
## Warning: Ignoring 121 observations
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Question 3
model <- lm(Debt_median ~ Net_Tuition + ACT_median, data = colleges)
x1 <- seq(min(colleges$Net_Tuition, na.rm = TRUE),
max(colleges$Net_Tuition, na.rm = TRUE),
length.out = 100)
x2 <- seq(min(colleges$ACT_median, na.rm = TRUE),
max(colleges$ACT_median, na.rm = TRUE),
length.out = 100)
grid <- expand.grid(Net_Tuition = x1, ACT_median = x2)
z <- predict(model, newdata = grid)
m <- matrix(z, nrow = 100, ncol = 100, byrow = TRUE)
plot_ly() %>%
add_trace(data = colleges, type = "scatter3d", mode = "markers", x = ~Net_Tuition, y = ~ACT_median,
z = ~Debt_median, color = I("black"),
marker = list(size = 3)) %>%
add_surface(x = x1, y = x2, z = m, colorscale = "Red")
## Warning: Ignoring 484 observations
Question 4
shootings <- read.csv('https://remiller1450.github.io/data/MassShootings.csv')
shoot1 <- shootings %>%
group_by(Year) %>%
summarize(sum(Fatalities), sum(Injured)) %>%
mutate(Fatalities = cumsum(`sum(Fatalities)`), Injured = cumsum(`sum(Injured)`))
shootlong <- pivot_longer(shoot1,
cols = c("Fatalities", "Injured"),
names_to = "Type",
values_to = "Total"
)
plot_ly(shootlong, x = ~Type, y = ~Total, type = "bar",
frame = ~Year) %>%
animation_opts(frame = 100, easing = "linear", redraw = FALSE)
Lab 12
# install.packages("maps")
# install.packages("maptools")
library(ggplot2)
library(dplyr)
library(maps)
library(maptools)
## Loading required package: sp
## The legacy packages maptools, rgdal, and rgeos, underpinning the sp package,
## which was just loaded, were retired in October 2023.
## Please refer to R-spatial evolution reports for details, especially
## https://r-spatial.org/r/2023/05/15/evolution4.html.
## It may be desirable to make the sf package available;
## package maintainers should consider adding sf to Suggests:.
## Please note that 'maptools' will be retired during October 2023,
## plan transition at your earliest convenience (see
## https://r-spatial.org/r/2023/05/15/evolution4.html and earlier blogs
## for guidance);some functionality will be moved to 'sp'.
## Checking rgeos availability: FALSE
theme_set(theme_bw())
states <- map_data("state")
counties <- map_data("county")
data("us.cities")
cities <- us.cities %>% filter(capital == 2) %>% filter(!(country.etc %in% c("AK", "HI")))
Question 1
ggplot(data = states, aes(x = long, y = lat)) +
geom_polygon(data = states, color = "black", fill = NA, linewidth = 0.3, alpha = 0.3, aes(group = group)) +
geom_polygon(data = counties, color = "blue", fill = "white", linewidth = 0.1, alpha = 0.5, aes(group = group)) +
geom_point(data = cities, aes(x = long, y = lat), size = 1.5, color = 'brown1')
Question 2
state_abr <- read.csv("https://collinn.github.io/data/state_abrv.csv")
data("midwest")
mid1 <- inner_join(x = midwest, y = state_abr, by = c("state" = "Abbreviation"))
mid2 <- mid1 %>%
mutate(region = str_to_lower(State)) %>%
mutate(subregion = str_to_lower(county))
midstates <- inner_join(x = states, y = mid2, by = c("region"))
## Warning in inner_join(x = states, y = mid2, by = c("region")): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 2940 of `x` matches multiple rows in `y`.
## ℹ Row 1 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
## "many-to-many"` to silence this warning.
midcounties <- inner_join(x = counties, y = mid2, by = c("region", "subregion"))
ggplot(data = midstates, aes(x = long, y = lat)) +
geom_polygon(data = midstates, color = "black", linewidth = 0.5, aes(group = group)) +
geom_polygon(data = midcounties, color = "black", linewidth = 0.2, alpha = 0.75, aes(fill = percollege, group = group)) +
scale_fill_continuous(type = "viridis", option = "H") +
labs(fill = "Percent College")
Question 3
world <- readShapeSpatial("world_shape/ne_50m_admin_0_countries")
## Warning: shapelib support is provided by GDAL through the sf and terra packages
## among others
## Warning: shapelib support is provided by GDAL through the sf and terra
## paackages among others
## Warning: shapelib support is provided by GDAL through the sf and terra packages
## among others
worldpoly <- fortify(world)
## Regions defined for each Polygons
worlddat <- world@data
worlddat$id <- as.character((1:nrow(worlddat)-1))
worldfull <- left_join(worldpoly, worlddat, by = "id")
worldfull1 <- worldfull %>%
mutate(gdpmd = cut_number(GDP_MD, n = 4, labels = c("1st Quartile", "2nd Quartile", "3rd Quartile", "4th Quartile")))
ggplot(data = worldfull1, aes(long, lat, group = group)) +
geom_polygon(aes(fill = gdpmd),
color = "black") +
scale_fill_brewer(palette = "YlGnBu")
